home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / hopfield.zip / HOPFIELD.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-27  |  11KB  |  350 lines
  1. {$R+}
  2. PROGRAM traveling_salesperson ;
  3.  
  4. (* Copyright 1987 - Knowledge Garden Inc.
  5.                     473A Malden Bridge Rd.
  6.                     R.D. 2
  7.                     Nassau, NY 12123       *)
  8.  
  9.  
  10. (* TSP solves a series of differential equations which simulate a neural
  11.    net solution of the traveling salesperson problem. The problem and
  12.    the equations are described in the article "Computing with Neurons" in
  13.    the July 1987 issue of AI Expert Magazine.
  14.  
  15.    This program has been tested using Turbo ver 3.01A on an IBM PC/AT. It has
  16.    been run under both DOS 3.2 and Concurrent 5.0 .
  17.  
  18.    We would be pleased to hear your comments, good or bad, or any applications
  19.    and modifications of the program. Contact us at:
  20.  
  21.      AI Expert
  22.      500 Howard St.
  23.      San Francisco, CA 94105
  24.  
  25.    Bill and Bev Thompson    *)
  26.  
  27. (* Uses Turbo3, CRT; *)  (* To compile with later versions of Turbo Pascal *)
  28.  
  29.  CONST
  30.   max_city = 'E' ;         (* max_city and max_position are the size of the *)
  31.   max_position = 5 ;       (* neural net. They must match. Cities run from *)
  32.                            (* A to max_city *)
  33.  
  34.   a = 500.0 ;              (* these are the weighting constants described *)
  35.   b = 500.0 ;              (* in the article. By changing then you can *)
  36.   c = 200.0 ;              (* get different types of solutions *)
  37.   d = 300.0 ;              (* d seems to have the most effect, increasing *)
  38.                            (* it produces shorter distance routes, but *)
  39.                            (* they aren't necessarily real tours. *)
  40.  
  41.   u0 = 0.02 ;              (* This parameter effects the output voltage of *)
  42.                            (* the amplifiers. Increasing it gives a broader *)
  43.                            (* curve. *)
  44.  
  45.   n = 7 ;                  (* This term affects global inhibition of the *)
  46.                            (* network. By setting it slightly larger than *)
  47.                            (* the number of cities, we seem to get better *)
  48.                            (* results *)
  49.  
  50.   h = 0.01 ;               (* The time step *)
  51.  
  52.  TYPE
  53.   cities = 'A' .. max_city ;
  54.   positions = 1 .. max_position ;
  55.  
  56.  
  57.  VAR
  58.   u : ARRAY [cities,positions] OF real ;      (* Input voltages *)
  59.   dist : ARRAY [cities,cities] OF real ;      (* Distances between cities *)
  60.  
  61.  
  62.  
  63.  FUNCTION v(city : cities ; position : positions) : real ;
  64.   (* This function calculates the output voltage from an amplifier
  65.      tanh calculates the hyperbolic tangent which gives the shape
  66.      of the output curve described in the article *)
  67.  
  68.   FUNCTION tanh(r : real) : real ;
  69.    VAR
  70.     r1,r2 : real ;
  71.    BEGIN
  72.     IF r > 20.0
  73.      THEN tanh := 1.0
  74.     ELSE IF r < -20.0
  75.      THEN tanh := -1.0
  76.     ELSE
  77.      BEGIN
  78.       r1 := exp(r) ;
  79.       r2 := exp(-r) ;
  80.       tanh := (r1 - r2) / (r1 + r2) ;
  81.      END ;
  82.    END ; (* tanh *)
  83.  
  84.   BEGIN
  85.    v := (1.0 + tanh(u[city,position] / u0)) / 2.0 ;
  86.   END ; (* v *)
  87.  
  88.  
  89.  FUNCTION f(city : cities ; position : positions) : real ;
  90.   (* This function calculates the right hand side of the differential
  91.      equations described in the article. It is not optimized for anything
  92.      and is pretty slow. *)
  93.  
  94.   FUNCTION col_sum(cty : cities) : real ;
  95.    (* column inhibition. This function helps keep the number of
  96.       output items in each column small *)
  97.    VAR
  98.     col : positions ;
  99.     sum : real ;
  100.    BEGIN
  101.     sum := 0.0 ;
  102.     FOR col := 1 TO max_position DO
  103.      IF col <> position
  104.       THEN sum := sum + v(cty,col) ;
  105.     col_sum := sum ;
  106.    END ; (* col_sum *)
  107.   FUNCTION row_sum(p : positions) : real ;
  108.    (* row inhibition. This function helps keep the number of
  109.       output items in each row small *)
  110.    VAR
  111.     row : cities ;
  112.     sum : real ;
  113.    BEGIN
  114.     sum := 0.0 ;
  115.     FOR row := 'A' TO max_city DO
  116.      IF row <> city
  117.       THEN sum := sum + v(row,p) ;
  118.     row_sum := sum ;
  119.    END ; (* row_sum *)
  120.  
  121.   FUNCTION matrix_sum : real ;
  122.    (* global inhibition. This function keeps the total number of cities
  123.       visited small *)
  124.    VAR
  125.     row : cities ;
  126.     col : positions ;
  127.     sum : real ;
  128.    BEGIN
  129.     sum := 0.0 ;
  130.     FOR row := 'A' TO max_city DO
  131.      FOR col := 1 TO max_position DO
  132.       sum := sum + v(row,col) ;
  133.     matrix_sum := sum ;
  134.    END ; (* matrix_sum *)
  135.  
  136.   FUNCTION dist_sum : real ;
  137.    (* distance inhibition. The inhibition is larger for longer tours.
  138.       Note that neuron (X,max_position) is connected to neuron (X,1),
  139.       in other words, the net is circular *)
  140.    VAR
  141.     c : cities ;
  142.     sum : real ;
  143.    BEGIN
  144.     sum := 0.0 ;
  145.     IF position = max_position
  146.      THEN
  147.       FOR c := 'A' TO max_city DO
  148.        sum := sum + dist[city,c] * (v(c,1) + v(c,position - 1))
  149.     ELSE IF position = 1
  150.      THEN
  151.       FOR c := 'A' TO max_city DO
  152.        sum := sum + dist[city,c] * (v(c,position + 1) + v(c,max_position))
  153.     ELSE
  154.      FOR c := 'A' TO max_city DO
  155.       sum := sum + dist[city,c] * (v(c,position + 1) + v(c,position - 1)) ;
  156.     dist_sum := sum ;
  157.    END ; (* dist_sum *)
  158.  
  159.   BEGIN
  160.    f := -u[city,position] - a * col_sum(city) - b * row_sum(position)        - c * (matrix_sum - n) - d * dist_sum ;
  161.   END ; (* f *)
  162.  
  163.  
  164.  PROCEDURE iterate ;
  165.   (* The basic solution process. This is a terrible way to solve differential
  166.      equations. Don't use it for anything serious, it performs poorly
  167.      when the number of cities gets larger than 7 or 8.
  168.      We keep iterating until the norm is less than tol or until the user
  169.      gets bored and presses the space bar. *)
  170.   CONST
  171.    tol = 1.0E-05 ;
  172.   VAR
  173.    step : integer ;
  174.    c1 : cities ;
  175.    i : positions ;
  176.    nr : real ;
  177.    u_old : ARRAY [cities,positions] OF real ;
  178.    ch : char ;
  179.  
  180.   FUNCTION norm : real ;
  181.    (* The norm is a measure of how much change there has been between
  182.       solutions. This is an infinity norm, calculated as the maximum
  183.       absolute value of the difference between components of the
  184.       solution vectors. We calculate the relative norm as:
  185.         N(u_new - u) / N(u). *)
  186.    VAR
  187.     cx : cities ;
  188.     ix : positions ;
  189.     max,max_comp : real ;
  190.    BEGIN
  191.     max := 0.0 ;
  192.     FOR cx := 'A' TO max_city DO
  193.      FOR ix := 1 TO max_position DO
  194.       BEGIN
  195.        IF abs(u_old[cx,ix] - u[cx,ix]) > max
  196.         THEN max := abs(u_old[cx,ix] - u[cx,ix]) ;
  197.        IF abs(u[cx,ix]) > max_comp
  198.         THEN max_comp := abs(u[cx,ix]) ;
  199.       END ;
  200.     norm := max / max_comp ;
  201.    END ; (* norm *)
  202.  
  203.   PROCEDURE print_matrix ;
  204.    (* Every so often, we print the input and output matrices so that
  205.       you can see what is going on. If the output matrix describes a
  206.       valid tour, we print that also. *)
  207.    VAR
  208.     c1 : cities ;
  209.     i : positions ;
  210.     vv : real ;
  211.     t : ARRAY [1 .. max_position] OF char ;
  212.     t_count : integer ;
  213.  
  214.    PROCEDURE write_tour ;    VAR
  215.      i : positions ;
  216.      t_dist : real ;
  217.     BEGIN
  218.      t_dist := 0.0 ;
  219.      FOR i := 1 TO max_position - 1 DO
  220.       t_dist := t_dist + dist[t[i],t[i+1]] ;
  221.      t_dist := t_dist + dist[t[max_position],t[1]] ;
  222.      write(output,'Tour: ') ;
  223.      FOR i := 1 TO max_position DO
  224.       write(output,t[i]) ;
  225.      writeln(output,'   dist = ',t_dist) ;
  226.     END ; (* write_tour *)
  227.  
  228.    PROCEDURE matrix_heading ;
  229.     VAR
  230.      i : positions ;
  231.     BEGIN
  232.      write(output,'  ') ;
  233.      FOR i := 1 TO max_position DO
  234.       write(output,i : 12) ;
  235.      writeln ;
  236.     END ; (* matrix_heading *)
  237.  
  238.    BEGIN
  239.     t_count := 0 ;
  240.     FOR i := 1 TO max_position DO
  241.      t[i] := chr(0) ;
  242.     writeln(output) ;
  243.     writeln(output,'Step: ',step,' norm = ',nr) ;
  244.     writeln(output) ;
  245.     writeln(output,'Input Voltages') ;
  246.     matrix_heading ;
  247.     FOR c1 := 'A' TO max_city DO
  248.      BEGIN
  249.       write(output,c1,'    ') ;
  250.       FOR i := 1 TO max_position DO
  251.        write(output,u[c1,i] : 12 : 5) ;
  252.       writeln(output) ;
  253.      END ;
  254.     writeln(output) ;
  255.     writeln(output,'Output Voltages') ;
  256.     matrix_heading ;
  257.     FOR c1 := 'A' TO max_city DO
  258.      BEGIN
  259.       write(output,c1,'    ') ;
  260.       FOR i := 1 TO max_position DO
  261.        BEGIN
  262.         vv := v(c1,i) ;
  263.         write(output,vv : 12 : 5) ;
  264.         IF (vv > 0.8) AND (t_count < max_position) AND (t[i] = chr(0))
  265.          THEN
  266.           BEGIN
  267.            t_count := t_count + 1 ;
  268.            t[i] := c1 ;          END ;
  269.        END ;
  270.       writeln(output) ;
  271.      END ;
  272.     IF t_count = max_position
  273.      THEN write_tour ;
  274.    END ; (* print_matrix *)
  275.  
  276.   BEGIN
  277.    step := 0 ;
  278.    REPEAT
  279.     step := step + 1 ;
  280.     move(u,u_old,sizeof(u)) ;
  281.     FOR c1 := 'A' TO max_city DO
  282.      FOR i := 1 TO max_position DO
  283.       u[c1,i] := u[c1,i] + h * f(c1,i) ;
  284.     nr := norm ;
  285.     IF ((step MOD 10) = 0) OR (step < 10)
  286.      THEN print_matrix ;
  287.    UNTIL keypressed OR (nr < tol) ;
  288.    IF keypressed
  289.     THEN read(kbd,ch) ;
  290.    print_matrix ;
  291.   END ; (* iterate *)
  292.  
  293.  
  294.  PROCEDURE initialize ;
  295.   TYPE
  296.    location = RECORD
  297.                x : real ;
  298.                y : real ;
  299.               END ;
  300.    city_array = ARRAY [cities] OF location ;
  301.   CONST
  302.    u00 = -0.01386 ;
  303. (* city_loc : city_array = ( (x : 0.21192 ; y : 0.54866),
  304.                              (x : 0.98817 ; y : 0.68465),
  305.                              (x : 0.53109 ; y : 0.72173),
  306.                              (x : 0.31459 ; y : 0.79397),
  307.                              (x : 0.63290 ; y : 0.85573)) ;
  308.  
  309.    These are the values we used for the article, if you want to
  310.    check our results, remove the comments here and use this data *)
  311.   VAR
  312.    c1,c2 : cities ;
  313.    i : positions ;
  314.    city_loc : city_array ;
  315.    ch : char ;
  316.   BEGIN
  317.    randomize ;
  318.    FOR c1 := 'A' TO max_city DO
  319.     BEGIN
  320.      city_loc[c1].x := random ;
  321.      city_loc[c1].y := random ;
  322.     END ;    FOR c1 := 'A' TO pred(max_city) DO
  323.     BEGIN
  324.      dist[c1,c1] := 0.0 ;
  325.      FOR c2 := succ(c1) TO max_city DO
  326.       BEGIN
  327.        dist[c1,c2] := sqrt(sqr(city_loc[c1].x - city_loc[c2].x) +
  328.                            sqr(city_loc[c1].y - city_loc[c2].y)) ;
  329.        dist[c2,c1] := dist[c1,c2] ;
  330.       END ;
  331.     END ;
  332.    dist[max_city,max_city] := 0.0 ;
  333.    FOR c1 := 'A' TO max_city DO
  334.     FOR i := 1 TO max_position DO
  335.      u[c1,i] := u00 + (((2 * random - 1.0) / 10.0) * u0) ;
  336.    clrscr ;
  337.    writeln('TSP         [c] 1987 Knowledge Garden Inc.') ;
  338.    writeln('                     473A Malden Bridge Rd') ;
  339.    writeln('                     Nassau, NY 12123') ;
  340.    writeln ;
  341.    writeln('Press <Space Bar> to begin - Press again to stop iterating.') ;
  342.    read(kbd,ch) ;
  343.   END ; (* initialize *)
  344.  
  345.  
  346.  BEGIN
  347.   initialize ;
  348.   iterate ;
  349.  END.
  350.